home *** CD-ROM | disk | FTP | other *** search
/ HAM Radio 1997 / HAM Radio 1997.iso / vcls / megares / megares.pas next >
Pascal/Delphi Source File  |  1996-04-08  |  12KB  |  390 lines
  1. { Newsgroups: comp.lang.pascal.delphi.components
  2. Subject: TMegaRegistry (v0.01=E1 code)
  3. From: christian.tiberg@silver.ct.se (Christian Tiberg)
  4. Date: Mon, 07 Aug 95 23:33:00 +0200
  5.  
  6. Hello All!
  7.  
  8. Below is the code for a component that can use a .INI file or the Windows
  9. Registry to store the data an application needs to save. It is as of yet in a
  10. very early stage, but I've tested it quite a bit and it seems stable. Any
  11. suggestions/bug reports welcome! The Mega in the name isn't because I'm so
  12. great, but the company I work for is named MegaComm :) }
  13.  
  14. unit Megareg;
  15.  
  16. interface
  17.  
  18. uses
  19.    SysUtils, WinTypes, WinProcs, Classes,
  20.    ShellAPI, IniFiles;
  21.  
  22. type
  23.    TWindowsRegistry = class(TIniFile)
  24.    private
  25.       { Private declarations }
  26.       AppName, Company: string;
  27.       Key: HKey;
  28.    protected
  29.       { Protected declarations }
  30.    public
  31.       { Public declarations }
  32.       constructor Create(const CompanyName, ApplicationName: string);
  33.       destructor Destroy; override;
  34.  
  35.       function ReadString(const Section, Ident, Default: string): string;
  36.       function ReadInteger(const Section, Ident: string; Default: longint):
  37. longint;
  38.       function ReadBool(const Section, Ident: string; Default: boolean):
  39. boolean;
  40.  
  41.       procedure WriteString(const Section, Ident, Value: string);
  42.       procedure WriteInteger(const Section, Ident: string; Value: longint);
  43.       procedure WriteBool(const Section, Ident: string; Value: boolean);
  44.  
  45.       procedure ReadSection(const Section: string; Strings: TStrings);
  46.       procedure ReadSectionValues(const Section: string; Strings: TStrings);
  47.       procedure EraseSection(const Section: string);
  48.    end;
  49.  
  50.    TMRPreference = (mrpAuto, mrpIni, mrpRegistry);
  51.    TMegaRegistry = class(TComponent)
  52.    private
  53.       FApp, FCompany, FIniName: string;
  54.       FPreference: TMRPreference;
  55.       MyStorage: TObject;
  56.       StoredAs: TMRPreference;
  57.  
  58.       procedure SetApp(AValue: string);
  59.       procedure SetCompany(AValue: string);
  60.       procedure SetIniName(AValue: string);
  61.       procedure SetPreference(AValue: TMRPreference);
  62.    protected
  63.       procedure Loaded; override;
  64.    public
  65.       destructor Destroy; override;
  66.  
  67.       procedure Close;
  68.       procedure Open;
  69.  
  70.       function ReadString(const Section, Ident, Default: string): string;
  71.       function ReadInteger(const Section, Ident: string; Default: longint):
  72. longint;
  73.       function ReadBool(const Section, Ident: string; Default: boolean):
  74. boolean;
  75.  
  76.       procedure WriteString(const Section, Ident, Value: string);
  77.       procedure WriteInteger(const Section, Ident: string; Value: longint);
  78.       procedure WriteBool(const Section, Ident: string; Value: boolean);
  79.  
  80.       procedure ReadSection(const Section: string; Strings: TStrings);
  81.       procedure ReadSectionValues(const Section: string; Strings: TStrings);
  82.       procedure EraseSection(const Section: string);
  83.    published
  84.       property App: string read FApp write SetApp;
  85.       property Company: string read FCompany write SetCompany;
  86.       property IniName: string read FIniName write SetIniName;
  87.       property Preference: TMRPreference read FPreference write SetPreference;
  88.    end;
  89.  
  90. procedure Register;
  91.  
  92. implementation
  93.  
  94. procedure Register;
  95. begin
  96.    RegisterComponents('New', [TMegaRegistry]);
  97. end;
  98.  
  99. constructor TWindowsRegistry.Create(const CompanyName, ApplicationName:
  100. string); var
  101.    tmp: array[1..256] of char;
  102. begin
  103.    AppName := ApplicationName;
  104.    Company := CompanyName;
  105.    if RegCreateKey(HKEY_CLASSES_ROOT, StrPCopy(@tmp, Company + '\' + AppName),
  106. Key) <> ERROR_SUCCESS then
  107.       Key := 0;
  108. end;
  109.  
  110. destructor TWindowsRegistry.Destroy;
  111. begin
  112.    if Key <> 0 then
  113.       RegCloseKey(Key);
  114. end;
  115.  
  116. function TWindowsRegistry.ReadString(const Section, Ident, Default: string):
  117. string; var
  118.    tmp, Buff: array[0..255] of char;
  119.    cb: longint;
  120. begin
  121.    cb := 256;
  122.    if RegQueryValue(Key, StrPCopy(tmp, Section + '\' + Ident), Buff, cb) =
  123. ERROR_SUCCESS then
  124.       ReadString := StrPas(Buff)
  125.    else
  126.       ReadString := Default;
  127. end;
  128.  
  129. function TWindowsRegistry.ReadInteger(const Section, Ident: string; Default:
  130. longint): longint; var
  131.    tmp, Buff: array[0..255] of char;
  132.    cb: longint;
  133. begin
  134.    cb := 256;
  135.    if RegQueryValue(Key, StrPCopy(tmp, Section + '\' + Ident), Buff, cb) =
  136. ERROR_SUCCESS then
  137.       ReadInteger := StrToInt(StrPas(Buff))
  138.    else
  139.       ReadInteger := Default;
  140. end;
  141.  
  142. function TWindowsRegistry.ReadBool(const Section, Ident: string; Default:
  143. boolean): boolean; var
  144.    tmp, Buff: array[0..255] of char;
  145.    cb: longint;
  146. begin
  147.    cb := 256;
  148.    if RegQueryValue(Key, StrPCopy(tmp, Section + '\' + Ident), Buff, cb) =
  149. ERROR_SUCCESS then
  150.       ReadBool := (StrToInt(StrPas(Buff)) <> 0)
  151.    else
  152.       ReadBool := Default;
  153. end;
  154.  
  155. procedure TWindowsRegistry.WriteString(const Section, Ident, Value: string);
  156. var
  157.    tmp, Buff: array[0..255] of char;
  158.    cb: longint;
  159. begin
  160.    cb := Length(Value);
  161.    RegSetValue(Key, StrPCopy(tmp, Section + '\' + Ident), REG_SZ,
  162. StrPCopy(Buff, Value), cb); end;
  163.  
  164. procedure TWindowsRegistry.WriteInteger(const Section, Ident: string; Value:
  165. longint); var
  166.    tmp, Buff: array[0..255] of char;
  167.    cb: longint;
  168.    AStr: string;
  169. begin
  170.    AStr := IntToStr(Value);
  171.    cb := Length(AStr);
  172.    RegSetValue(Key, StrPCopy(tmp, Section + '\' + Ident), REG_SZ,
  173. StrPCopy(Buff, AStr), cb); end;
  174.  
  175. procedure TWindowsRegistry.WriteBool(const Section, Ident: string; Value:
  176. boolean); var
  177.    tmp, Buff: array[0..255] of char;
  178.    cb: longint;
  179.    AStr: string;
  180. begin
  181.    if Value then
  182.       AStr := '1'
  183.    else
  184.       AStr := '0';
  185.    cb := Length(AStr);
  186.    RegSetValue(Key, StrPCopy(tmp, Section + '\' + Ident), REG_SZ,
  187. StrPCopy(Buff, AStr), cb); end;
  188.  
  189. procedure TWindowsRegistry.ReadSection(const Section: string; Strings:
  190. TStrings); var
  191.    TmpKey: HKey;
  192.    Buff, Verde: array[1..256] of char;
  193.    Index, Resultat, cb: longint;
  194. begin
  195.    Strings.Clear;
  196.    if RegOpenKey(Key, StrPCopy(@Buff, Section), TmpKey) <> ERROR_SUCCESS then
  197.       exit;
  198.    Index := 0;
  199.    Resultat := RegEnumKey(TmpKey, Index, @Buff, 256);
  200.    while Resultat = ERROR_SUCCESS do
  201.       begin
  202.          Strings.Add(StrPas(@Buff));
  203.          inc(Index);
  204.          Resultat := RegEnumKey(TmpKey, Index, @Buff, 256);
  205.       end;
  206.    RegCloseKey(TmpKey);
  207. end;
  208.  
  209. procedure TWindowsRegistry.ReadSectionValues(const Section: string; Strings:
  210. TStrings); var
  211.    TmpKey: HKey;
  212.    Buff, Verde: array[1..256] of char;
  213.    Index, Resultat, cb: longint;
  214.    st: string;
  215. begin
  216.    Strings.Clear;
  217.    if RegOpenKey(Key, StrPCopy(@Buff, Section), TmpKey) <> ERROR_SUCCESS then
  218.       exit;
  219.    Index := 0;
  220.    Resultat := RegEnumKey(TmpKey, Index, @Buff, 256);
  221.    while Resultat = ERROR_SUCCESS do
  222.       begin
  223.          cb := 256;
  224.          RegQueryValue(TmpKey, @Buff, @Verde, cb);
  225.          st := StrPas(@Verde);
  226.          if st <> '' then
  227.             Strings.Add(StrPas(@Buff) + '=' + st);
  228.          inc(Index);
  229.          Resultat := RegEnumKey(TmpKey, Index, @Buff, 256);
  230.       end;
  231.    RegCloseKey(TmpKey);
  232. end;
  233.  
  234. procedure TWindowsRegistry.EraseSection(const Section: string); var
  235.    Buff: array[1..256] of char;
  236. begin
  237.    RegDeleteKey(Key, StrPCopy(@Buff, Section));
  238. end;
  239.  
  240. procedure TMegaRegistry.SetApp(AValue: string);
  241. begin
  242.    Close;
  243.    FApp := AValue;
  244. end;
  245.  
  246. procedure TMegaRegistry.SetCompany(AValue: string);
  247. begin
  248.    Close;
  249.    FCompany := AValue;
  250. end;
  251.  
  252. procedure TMegaRegistry.SetIniName(AValue: string);
  253. begin
  254.    Close;
  255.    FIniName := AValue;
  256. end;
  257.  
  258. procedure TMegaRegistry.SetPreference(AValue: TMRPreference); begin
  259.    Close;
  260.    FPreference := AValue;
  261. end;
  262.  
  263. procedure TMegaRegistry.Loaded;
  264. begin
  265.    inherited Loaded;
  266.    if not (csDesigning in ComponentState) then
  267.       Open;
  268. end;
  269.  
  270. destructor TMegaRegistry.Destroy;
  271. begin
  272.    Close;
  273.   inherited Destroy;
  274. end;
  275.  
  276. procedure TMegaRegistry.Close;
  277. begin
  278.    if MyStorage <> nil then
  279.       if StoredAs = mrpIni then
  280.          (MyStorage as TIniFile).Free
  281.       else
  282.          (MyStorage as TWindowsRegistry).Free;
  283.    MyStorage := nil;
  284. end;
  285.  
  286. procedure TMegaRegistry.Open;
  287. var
  288.    ver, maj, min: longint;
  289. begin
  290.    Close;
  291.    if (App = '') or (Company = '') or (IniName = '') then
  292.       exit;
  293.    if Preference = mrpAuto then
  294.       begin
  295.          ver := (GetVersion and $FFFF);
  296.          maj := ver and $FF;
  297.         min := (ver and $FF00) shr 8;
  298.          if (maj > 3) or ((maj = 3) and (min > 20)) then
  299.             StoredAs := mrpRegistry
  300.          else
  301.             StoredAs := mrpIni;
  302.       end
  303.    else
  304.       StoredAs := Preference;
  305.    if StoredAs = mrpIni then
  306.       begin
  307.          if IniName = '' then
  308.             exit;
  309.          MyStorage := TIniFile.Create(IniName);
  310.       end
  311.    else
  312.       begin
  313.          if (App = '') or (Company = '') then
  314.             exit;
  315.          MyStorage := TWindowsRegistry.Create(Company, App);
  316.       end;
  317. end;
  318.  
  319. function TMegaRegistry.ReadString(const Section, Ident, Default: string):
  320. string; begin
  321.    if StoredAs = mrpIni then
  322.       ReadString := (MyStorage as TIniFile).ReadString(Section, Ident, Default)
  323.    else
  324.       ReadString := (MyStorage as TWindowsRegistry).ReadString(Section, Ident,
  325. Default); end;
  326.  
  327. function TMegaRegistry.ReadInteger(const Section, Ident: string; Default:
  328. longint): longint; begin
  329.    if StoredAs = mrpIni then
  330.       ReadInteger := (MyStorage as TIniFile).ReadInteger(Section, Ident,
  331. Default)
  332.    else
  333.       ReadInteger := (MyStorage as TWindowsRegistry).ReadInteger(Section,
  334. Ident, Default); end;
  335.  
  336. function TMegaRegistry.ReadBool(const Section, Ident: string; Default:
  337. boolean): boolean; begin
  338.    if StoredAs = mrpIni then
  339.       ReadBool := (MyStorage as TIniFile).ReadBool(Section, Ident, Default)
  340.    else
  341.       ReadBool := (MyStorage as TWindowsRegistry).ReadBool(Section, Ident,
  342. Default); end;
  343.  
  344. procedure TMegaRegistry.WriteString(const Section, Ident, Value: string); begin
  345.    if StoredAs = mrpIni then
  346.       (MyStorage as TIniFile).WriteString(Section, Ident, Value)
  347.    else
  348.       (MyStorage as TWindowsRegistry).WriteString(Section, Ident, Value) end;
  349.  
  350. procedure TMegaRegistry.WriteInteger(const Section, Ident: string; Value:
  351. longint); begin
  352.    if StoredAs = mrpIni then
  353.       (MyStorage as TIniFile).WriteInteger(Section, Ident, Value)
  354.    else
  355.       (MyStorage as TWindowsRegistry).WriteInteger(Section, Ident, Value) end;
  356.  
  357. procedure TMegaRegistry.WriteBool(const Section, Ident: string; Value:
  358. boolean); begin
  359.    if StoredAs = mrpIni then
  360.       (MyStorage as TIniFile).WriteBool(Section, Ident, Value)
  361.    else
  362.       (MyStorage as TWindowsRegistry).WriteBool(Section, Ident, Value); end;
  363.  
  364. procedure TMegaRegistry.ReadSection(const Section: string; Strings: TStrings);
  365. begin
  366.    if StoredAs = mrpIni then
  367.       (MyStorage as TIniFile).ReadSection(Section, Strings)
  368.    else
  369.       (MyStorage as TWindowsRegistry).ReadSection(Section, Strings); end;
  370.  
  371. procedure TMegaRegistry.ReadSectionValues(const Section: string; Strings:
  372. TStrings); begin
  373.    if StoredAs = mrpIni then
  374.       (MyStorage as TIniFile).ReadSectionValues(Section, Strings)
  375.    else
  376.       (MyStorage as TWindowsRegistry).ReadSectionValues(Section, Strings); end;
  377.  
  378. procedure TMegaRegistry.EraseSection(const Section: string); begin
  379.    if StoredAs = mrpIni then
  380.       (MyStorage as TIniFile).EraseSection(Section)
  381.    else
  382.       (MyStorage as TWindowsRegistry).EraseSection(Section); end;
  383.  
  384. end.
  385.  
  386. { Best regards,
  387.    Christian // ctiberg@silver.ct.se }
  388.  
  389.  
  390.